00100	C***** INCOME TAX HELPER ******
00200		DIMENSION WAGES(10),DIV(10),RINT(10),BINC(10),
00300		1 CAS(10),SUPS(10),ROY(10),PENS(10),CAPG(10),SITR(10),
00400		1 OTH(10),EBEX(10),RMED(20),TAXES(10),XOTH(10),CONTR(10),
00500		1 TLOSS(10),RMIN(10),DOC(10),DOTH(10),RTAX(10),RMORT(10),
00600		1 ROTH(10),OCONT(10),OCASH(10),UNION(10),RMOTH(10),WTAX(10)
00700		1,ETAX(10),FICA(10)
00800		COMMON K,ACC,IOUT
00900		IOUT=5
01000	C****  -99=BACKUP  **************
01100	C*** UP TO 10 NUMBERS MAY BE ENTERED IF PROG. GIVES <CR> BEFORE ACCEPT.
01200	C  5=TTY  3=LPT
01300		ACC=-1
01400		TYPE 200
01500		ACCEPT 3,N
01600		IF(N.NE.'O')GO TO 60
01700	200	FORMAT(' N=NEW TAX WORK -- OR O=GET OLD FILE. H=HELP'/)
01800		TYPE 85
01900		ACCEPT 4,NAME
02000		GO TO 201
02100	33	FORMAT('+ STANDARD DEDUCTION - NOT MORE THAN $2000 OR $1000'/)
02200	45	FORMAT('+ REAL ESTATE.'/)
02300	55	FORMAT('+ INSURANCE REIMBURSEMENT.'$)
02400	57	FORMAT('+ ALIMONY PAID.'/)
02500	58	FORMAT('+ UNION DUES.'/)
02600	59	FORMAT('+ CHILD AND DEPENDENT CARE(FORM 2441)'/)
02700	60	FORMAT('+ TOTAL---   ',F10.2/)
02800		IF(N.NE.'H')GO TO 4
02900		TYPE 202
03000		CALL EXIT
03100	202	FORMAT(' ASK LCS FOR INFORMATION.')
03200	1	FORMAT(20F)
03300	2	FORMAT(F10.2/)
03400	3	FORMAT(A1)
03500	4	FORMAT(A5)
03600		I=' '
03700	
03800	601	FORMAT(' ***** YOU ARE ON FORM 1040, PG.1 *****'/)
03900		WRITE(IOUT,601)
04000		IF(ACC.EQ.0)GO TO 102
04050		TYPE 604
04075	604	FORMAT(' TO BACKUP TYPE -99 '/)
04100	600	FORMAT('+ ARE YOU MARRIED, FILING SEPARATELY? '$)
04200		CALL TYP(3,I)
04300		ACCEPT 3,MFS
04400	102	CALL TYP(7,I)
04500		WRITE(IOUT, 11)
04600	11	FORMAT('+ NUMBER OF EXEMPTIONS  ',$)
04700		IF(ACC)ACCEPT 1,EX
04800		IF(EX.EQ.-99)GO TO 600
04900		IF(ACC.EQ.0)WRITE(IOUT,2)EX
05000	1100	CALL TYP(9,I)
05100		WRITE(IOUT, 12)
05200	12	FORMAT('+ WAGES, ETC. (FROM W2 FORMS)  '/)
05300		IF(ACC)ACCEPT 1,WAGES
05400		IF(WAGES(1).EQ.-99)GO TO 102
05500		CALL ADUP(WG,WAGES)
05600	103	CALL TYP(10,'A')
05700		WRITE(IOUT, 13)
05800	13	FORMAT('+ DIVIDENDS.'/)
05900		IF(ACC)ACCEPT 1,DIV
06000		IF(DIV(1).EQ.-99)GO TO 102
06100		CALL ADUP(DT,DIV)
06200	104	CALL TYP(10,'B')
06300		WRITE(IOUT, 14)
06400	14	FORMAT('+ DIVIDEND EXCLUSION.  ',$)
06500		IF(ACC)ACCEPT 1,DEX
06600		IF(DEX.EQ.-99)GO TO 103
06700		IF(ACC.EQ.0)WRITE(IOUT,2)DEX
06800		TOTD=DT-DEX
06900		CALL TYP(10,'C')
07000		WRITE(IOUT, 15)TOTD
07100	15	FORMAT('+ TOTAL DIVIDENDS.  ',F11.2/)
07200	105	CALL TYP(11,I)
07300		WRITE(IOUT, 16)
07400	16	FORMAT('+ INTEREST INCOME.  '/)
07500		IF(ACC)ACCEPT 1,RINT
07600		IF(RINT(1).EQ.-99)GO TO 104
07700		CALL ADUP(RT,RINT)
07800	106	CALL TYP(12,I)
07900		WRITE(IOUT, 17)
08000	17	FORMAT('+ OTHER INCOME.'/)
08100	602	FORMAT(' ***** GO TO PAGE 2 OF FORM 1040 *****'/,
08150		1' ***** TYPE -999 TO SKIP OVER SECTION AND RETURN TO PG.1'/)
08160		IF(ACC.EQ.0.AND.T38.EQ.0)GO TO 1603
08200		WRITE(IOUT,602)
08300		CALL TYP(28,I)
08400		WRITE(IOUT, 18)
08500	18	FORMAT('+ BUSINESS INCOME-LOSS.'/)
08600		IF(ACC)ACCEPT 1,BINC
08650		IF(BINC(1).EQ.-999)GO TO 1603
08700		IF(BINC(1).EQ.-99)GO TO 105
08800		CALL ADUP(BI,BINC)
08900	107	CALL TYP(29,I)
09000		WRITE(IOUT, 19)
09100	19	FORMAT('+ CAPITAL ASSETS.'/)
09200		IF(ACC)ACCEPT 1,CAS
09300		IF(CAS(1).EQ.-99)GO TO 106
09400		CALL ADUP(CA,CAS)
09500	108	CALL TYP(30,I)
09600		WRITE(IOUT, 20)
09700	20	FORMAT('+ SUPPLEMENTAL SCHEDULE.'/)
09800		IF(ACC)ACCEPT 1,SUPS
09900		IF(SUPS(1).EQ.-99)GO TO 107
10000		CALL ADUP(SU,SUPS)
10100	109	CALL TYP(31,I)
10200		WRITE(IOUT, 21)
10300	21	FORMAT('+ RENTS, ROYALTIES, ETC.'/)
10400		IF(ACC)ACCEPT 1,ROY
10500		IF(ROY(1).EQ.-99)GO TO 108
10600		CALL ADUP(RY,ROY)
10700	110	CALL TYP(33,I)
10800		WRITE(IOUT, 22)
10900	22	FORMAT('+ PENSIONS, ETC.'/)
11000		IF(ACC)ACCEPT 1,PENS
11100		IF(PENS(1).EQ.-99)GO TO 109
11200		CALL ADUP(PE,PENS)
11300	111	CALL TYP(34,I)
11400		WRITE(IOUT, 23)
11500	23	FORMAT('+ 50% CAPITAL GAIN.'/)
11600		IF(ACC)ACCEPT 1,CAPG
11700		IF(CAPG(1).EQ.-99)GO TO 110
11800		CALL ADUP(CP,CAPG)
11900	112	CALL TYP(35,I)
12000		WRITE(IOUT, 24)
12100	24	FORMAT('+ STATE INCOME TAX REFUNDS.'/)
12200		IF(ACC)ACCEPT 1,SITR
12300		IF(SITR(1).EQ.-99)GO TO 111
12400		CALL ADUP(SI,SITR)
12500	113	CALL TYP(36,I)
12600		WRITE(IOUT, 25)
12700	25	FORMAT('+ ALIMONY INCOME.  '$)
12800		IF(ACC)ACCEPT 1,ALM
12900		IF(ALM.EQ.-99)GO TO 112
13000		IF(ACC.EQ.0)WRITE(IOUT,2)ALM
13100	114	CALL TYP(37,I)
13200		WRITE(IOUT, 26)
13300	26	FORMAT('+ OTHER.'/)
13400		IF(ACC)ACCEPT 1,OTH
13500		IF(OTH(1).EQ.-99)GO TO 113
13600		CALL ADUP(OT,OTH)
13700		CALL TYP(38,I)
13800		T38=BI+CA+SU+RY+PE+CP+SI+ALM+OT
13900		WRITE(IOUT, 60)T38
14000	603	FORMAT(' ***** GO BACK TO PAGE 1 OF FORM 1040 *****'/)
14100		WRITE(IOUT,603)
14200	1603	CALL TYP(12,I)
14250		IF(BINC(1).EQ.-999)BINC(1)=0
14300		WRITE(IOUT,60)T38
14400		CALL TYP(13,I)
14500		T13=WG+TOTD+RT+T38
14600		WRITE(IOUT, 60)T13
14700	115	CALL TYP(14,I)
14800		WRITE(IOUT, 27)
14900	27	FORMAT('+ ADJUSTMENTS TO INCOME'/)
15000	
15050		IF(ACC.EQ.0.AND.T43.EQ.0)GO TO 1604
15100		WRITE(IOUT,602)
15200		CALL TYP(39,I)
15300		WRITE(IOUT, 28)
15400	28	FORMAT('+ SICK PAY.  ',$)
15500		IF(ACC)ACCEPT 1,SICK
15550		IF(SICK.EQ.-999)GO TO 1604
15600		IF(SICK.EQ.-99)GO TO 114
15700		IF(ACC.EQ.0)WRITE(IOUT,2)SICK
15800	116	CALL TYP(40,I)
15900		WRITE(IOUT, 29)
16000	29	FORMAT('+ MOVING EXPENSES.  ',$)
16100		IF(ACC)ACCEPT 1,RMEX
16200		IF(RMEX.EQ.-99)GO TO 115
16300		IF(ACC.EQ.0)WRITE(IOUT,2)RMEX
16400	117	CALL TYP(41,I)
16500		WRITE(IOUT, 30)
16600	30	FORMAT('+ EMPLOYEE BUSINESS EXPENSES.'/)
16700		IF(ACC)ACCEPT 1,EBEX
16800		IF(EBEX(1).EQ.-99)GO TO 116
16900		CALL ADUP(EB,EBEX)
17000	118	CALL TYP(42,I)
17100		WRITE(IOUT, 31)
17200	31	FORMAT('+ SELF-EMPLOYED RETIREMENT PLAN.  '$)
17300		IF(ACC)ACCEPT 1,SER
17400		IF(SER.EQ.-99)GO TO 117
17500		IF(ACC.EQ.0)WRITE(IOUT,2)SER
17600		CALL TYP(43,I)
17700		T43=SICK+RMEX+EB+SER
17800		WRITE(IOUT, 60)T43
17900	
18000		WRITE(IOUT,603)
18100	1604	CALL TYP(14,I)
18150		IF(SICK.EQ.-999)SICK=0
18200		WRITE(IOUT, 60)T43
18300		T15=T13-T43
18400		CALL TYP(15,I)
18500		WRITE(IOUT, 32)T15
18600	32	FORMAT('+ ADJUSTED GROSS INCOME.',F13.2/)
18700		IF(T15.LT.10000.)CALL SMALL(T15)
18800		CALL STDED(T15)
18900		IF(ACC)WRITE(IOUT, 34)
19000	34	FORMAT(/' ***** ITEMIZE DEDUCTIONS? '$)
19100		IF(ACC)ACCEPT 3,JIT
19200		IF(JIT.EQ.'N')GO TO 6900
19300	C*************************************
19400	119	WRITE(IOUT, 35)
19500	35	FORMAT(/' ***** GO TO SCHEDULE A *****')
19600		WRITE(IOUT, 36)
19700	36	FORMAT(/' ----- MEDICAL - DENTAL '/)
19800		IF(ACC.EQ.0)GO TO 3700
19900		CALL TYP(1,I)
20000		WRITE(IOUT, 37)
20100	37	FORMAT('+ TOTAL OF INSURANCE PREMIUMS. '/)
20200		IF(ACC)ACCEPT 1,RMIN
20300		IF(RMIN(1).EQ.-99)GO TO 118
20400		CALL ADUP(RMI,RMIN)
20500	3700	T1=RMI/2.
20600		IF(T1.GT.150.)T1=150.
20700		CALL TYP(1,I)
20800		WRITE(IOUT, 2)T1
20900	120	CALL TYP(2,I)
21000		WRITE(IOUT, 38)
21100	38	FORMAT('+ MEDICINE AND DRUGS. '/)
21200		IF(ACC)ACCEPT 1,RMED
21300		IF(RMED(1).EQ.-99)GO TO 119
21400		CALL ADUP(RM,RMED)
21500		CALL TYP(3,I)
21600	61	FORMAT('+ 1% OF LINE 15-- ',F10.2/)
21700		ONP=T15/100.
21800		WRITE(IOUT, 61)ONP
21900		T4=RM-ONP
22000		IF(T4)T4=0
22100		CALL TYP(4,I)
22200		WRITE(IOUT, 2)T4
22300		CALL TYP(5,I)
22400		T5=RMI-T1
22500		IF(T5)T5=0
22600	62	FORMAT('+ BALANCE OF INSURANCE PREMIUMS. ',F10.2/)
22700		WRITE(IOUT, 62)T5
22800		CALL TYP(6,I)
22900		WRITE(IOUT, 39)
23000	39	FORMAT('+ OTHER MEDICAL AND DENTAL EXPENSES.'/)
23100	121	CALL TYP(6,'A')
23200		WRITE(IOUT, 40)
23300	40	FORMAT('+ DOCTORS, DENTISTS, ETC.'/)
23400		IF(ACC)ACCEPT 1,DOC
23500		IF(DOC(1).EQ.-99)GO TO 120
23600		CALL ADUP(DO,DOC)
23700	122	CALL TYP(6,'B')
23800		WRITE(IOUT, 41)
23900	41	FORMAT('+ HOSPITALS.'$)
24000		IF(ACC)ACCEPT 1,HOSP
24100		IF(HOSP.EQ.-99)GO TO 121
24200		IF(ACC.EQ.0)WRITE(IOUT,2)HOSP
24300	123	CALL TYP(6,'C')
24400		WRITE(IOUT, 26)
24500		IF(ACC)ACCEPT 1,DOTH
24600		IF(DOTH(1).EQ.-99)GO TO 122
24700		CALL ADUP(DT,DOTH)
24800		T7=T4+T5+DO+HOSP+DT
24900		CALL TYP(7,I)
25000		WRITE(IOUT, 60)T7
25100		T8=T15*.03
25200		CALL TYP(8,I)
25300		WRITE(IOUT, 2)T8
25400		T9=T7-T8
25500		IF(T9)T9=0
25600		CALL TYP(9,I)
25700		WRITE(IOUT, 2)T9
25800		T10=T9+T1
25900		CALL TYP(10,I)
26000		WRITE(IOUT, 60)T10
26100		CALL TYP(35,I)
26200		WRITE(IOUT, 60)T10
26300	
26400	43	FORMAT(/' ----- TAXES'/)
26500		WRITE(IOUT, 43)
26600	124	CALL TYP(11,I)
26700		WRITE(IOUT, 44)
26800	44	FORMAT('+ STATE AND LOCAL INCOME.'/)
26900		IF(ACC)ACCEPT 1,TAXES
27000		IF(TAXES(1).EQ.-99)GO TO 123
27100		CALL ADUP(TA,TAXES)
27200	125	CALL TYP(12,I)
27300		WRITE(IOUT, 45)
27400		IF(ACC)ACCEPT 1,RTAX
27500		IF(RTAX(1).EQ.-99)GO TO 124
27600		CALL ADUP(RX,RTAX)
27700	126	CALL TYP(13,I)
27800		WRITE(IOUT, 42)
27900	42	FORMAT('+ GASOLINE TAX (SEE TABLES)  '$)
28000		IF(ACC)ACCEPT 1,GTAX
28100		IF(GTAX.EQ.-99)GO TO 125
28200		IF(ACC.EQ.0)WRITE(IOUT,2)GTAX
28300	127	CALL TYP(14,I)
28400		WRITE(IOUT, 46)
28500	46	FORMAT('+ GENERAL SALES. (SEE TABLES) '$)
28600		IF(ACC)ACCEPT 1,STAX
28700		IF(STAX.EQ.-99)GO TO 126
28800		IF(ACC.EQ.0)WRITE(IOUT,2)STAX
28900	128	CALL TYP(15,I)
29000		WRITE(IOUT, 47)
29100	47	FORMAT('+ PERSONAL PROPERTY'/)
29200		IF(ACC)ACCEPT 1,PTAX
29300		IF(PTAX.EQ.-99)GO TO 127
29400		IF(ACC.EQ.0)WRITE(IOUT,2)PTAX
29500	129	CALL TYP(16,I)
29600		WRITE(IOUT, 26)
29700		IF(ACC)ACCEPT 1,XOTH
29800		IF(XOTH(1).EQ.-99)GO TO 128
29900		CALL ADUP(XO,XOTH)
30000		CALL TYP(17,I)
30100		T17=TA+RX+GTAX+STAX+PTAX+XO
30200		WRITE(IOUT, 60)T17
30300		CALL TYP(36,I)
30400		WRITE(IOUT, 60)T17
30500	130	WRITE(IOUT, 48)
30600	48	FORMAT(/' ----- INTEREST EXPENSE'/)
30700		CALL TYP(18,I)
30800		WRITE(IOUT, 49)
30900	49	FORMAT('+ HOME MORTGAGE.'/)
31000		IF(ACC)ACCEPT 1,RMORT
31100		IF(RMORT(1).EQ.-99)GO TO 129
31200		CALL ADUP(RMO,RMORT)
31300	131	CALL TYP(19,I)
31400		WRITE(IOUT, 26)
31500		IF(ACC)ACCEPT 1,ROTH
31600		IF(ROTH(1).EQ.-99)GO TO 130
31700		CALL ADUP(ROH,ROTH)
31800		CALL TYP(20,I)	
31900		T20=RMO+ROH
32000		WRITE(IOUT, 60)T20
32100		CALL TYP(37,I)
32200		WRITE(IOUT, 60)T20
32300	
32400	132	WRITE(IOUT, 50)
32500	50	FORMAT(/' ----- CONTRIBUTIONS '/)
32600		CALL TYP(21,'A')
32700		WRITE(IOUT, 51)
32800	51	FORMAT('+ CASH CONTRIBUTIONS.'/)
32900		IF(ACC)ACCEPT 1,CONTR
33000		IF(CONTR(1).EQ.-99)GO TO 131
33100		CALL ADUP(CO,CONTR)
33200	133	CALL TYP(21,'B')
33300		WRITE(IOUT, 26)
33400		IF(ACC)ACCEPT 1,OCONT
33500		IF(OCONT(1).EQ.-99)GO TO 132
33600		CALL ADUP(OC,OCONT)
33700	134	CALL TYP(22,I)
33800		WRITE(IOUT, 510)
33900	510	FORMAT('+ OTHER THAN CASH (SEE PAGE 12).'/)
34000		IF(ACC)ACCEPT 1,OCASH
34100		IF(OCASH(1).EQ.-99)GO TO 133
34200		CALL ADUP(OCA,OCASH)
34300	135	CALL TYP(23,I)
34400		WRITE(IOUT, 52)
34500	52	FORMAT('+ CARRY OVER FROM PRIOR YEARS.'$)
34600		IF(ACC)ACCEPT 1,PRIOR
34700		IF(PRIOR.EQ.-99)GO TO 134
34800		IF(ACC.EQ.0)WRITE(IOUT,2)PRIOR
34900	136	CALL TYP(24,I)
35000		T24=PRIOR+OCA+OC+CO
35100		WRITE(IOUT, 60)T24
35200		CALL TYP(38,I)
35300		WRITE(IOUT, 60)T24
35400	137	WRITE(IOUT, 53)
35500	53	FORMAT(/' ----- CASUALTY OR THEFT LOSSES'/)
35600		CALL TYP(25,I)
35700	54	FORMAT('+ LOSS BEFORE INSURANCE REIMBURSEMENT.'/)
35800		WRITE(IOUT, 54)
35900		IF(ACC)ACCEPT 1,RLOSS
36000		IF(RLOSS.EQ.-99)GO TO 136
36100		IF(ACC.EQ.0)WRITE(IOUT,2)RLOSS
36200	138	CALL TYP(26,I)
36300		WRITE(IOUT, 55)
36400		IF(ACC)ACCEPT 1,RIR
36500		IF(RIR.EQ.-99)GO TO 137
36600		IF(ACC.EQ.0)WRITE(IOUT,2)RIR
36700		CALL TYP(27,I)
36800		T27=RLOSS-RIR
36900		IF(T27)T27=0
37000		WRITE(IOUT, 60)T27
37100		T28=100.
37200		IF(T27.LT.T28)T28=T27
37300		CALL TYP(28,I)
37400		WRITE(IOUT, 2)T28
37500		T29=T27-T28
37600		CALL TYP(29,I)
37700		WRITE(IOUT, 60)T29
37800		CALL TYP(39,I)
37900		WRITE(IOUT, 60)T29
38000	139	WRITE(IOUT, 56)
38100	56	FORMAT(/' ----- MISCELLANEOUS DEDUCTIONS '/)
38200		CALL TYP(30,I)
38300		WRITE(IOUT, 57)
38400		IF(ACC)ACCEPT 1,ALIMONY
38500		IF(ALIMONY.EQ.-99)GO TO 138
38600		IF(ACC.EQ.0)WRITE(IOUT,2)ALIMONY
38700	140	CALL TYP(31,I)
38800		WRITE(IOUT, 58)
38900		IF(ACC)ACCEPT 1,UNION
39000		IF(UNION(1).EQ.-99)GO TO 139
39100		CALL ADUP(UN,UNION)
39200	141	CALL TYP(32,I)
39300		WRITE(IOUT, 59)
39400		IF(ACC)ACCEPT 1,CAD
39500		IF(CAD.EQ.-99)GO TO 140
39600		IF(ACC.EQ.0)WRITE(IOUT,2)CAD
39700	142	CALL TYP(33,I)
39800		WRITE(IOUT, 26)
39900		IF(ACC)ACCEPT 1,RMOTH
40000		IF(RMOTH(1).EQ.-99)GO TO 141
40100		CALL ADUP(RMO,RMOTH)
40200		T34=ALIMONY+UN+CAD+RMO
40300		CALL TYP(34,I)
40400		WRITE(IOUT, 60)T34
40500		CALL TYP(40,I)
40600		WRITE(IOUT, 60)T34
40700		WRITE(IOUT, 63)
40800	63	FORMAT(' ----- SUMMARY OF DEDUCTIONS.'/)
40900		CALL TYP(35,I)
41000		WRITE(IOUT, 64)T10
41100	64	FORMAT('+ MEDICAL AND DENTAL.',F12.2/)
41200		CALL TYP(36,I)
41300		WRITE(IOUT, 65)T17
41400	65	FORMAT('+ TOTAL TAXES.',F12.2/)
41500	650	FORMAT('+ TOTAL INTEREST.',F12.2/)
41600	66	FORMAT('+ TOTAL CONTRIBUTIONS.',F12.2/)
41700	67	FORMAT('+ CASUALTY OR THEFT LOSS.',F12.2/)
41800	68	FORMAT('+ TOTAL MISCELLANEAOUS.',F12.2/)
41900	69	FORMAT('+ TOTAL DEDUCTIONS.',F12.2/)
42000		CALL TYP(37,I)
42100		WRITE(IOUT, 650)T20
42200		CALL TYP(38,I)
42300		WRITE(IOUT, 66)T24
42400		CALL TYP(39,I)
42500		WRITE(IOUT, 67)T29
42600		CALL TYP(40,I)
42700		WRITE(IOUT, 68)T34
42800		CALL TYP(41,I)
42900		T41=T34+T29+T20+T17+T10
43000		WRITE(IOUT, 69)T41
43100	
43200		WRITE(IOUT,602)
43300	6900	CALL TYP(44,I)
43400		WRITE(IOUT,32)T15
43500		IF(JIT.NE.'Y')GO TO 6901
43600		CALL TYP(45,'A')
43700		WRITE(IOUT, 69)T41
43800	6901	T45B=T15*.15
43900		X=2000
44000		IF(MFS.EQ.'Y')X=1000
44100		IF(T45B.GT.X)T45B=X
44200		CALL TYP(45,'B')
44300		WRITE(IOUT, 69)T45B
44400		T46=T15-T41
44500		T46B=T15-T45B
44600		IF(JIT.NE.'Y')GO TO 6902
44700		CALL TYP(46,'A')
44800		WRITE(IOUT, 2)T46
44900	6902	CALL TYP(46,'B')
45000		WRITE(IOUT, 2)T46B
45100		CALL TYP(47,I)
45200		X=EX*750
45300		WRITE(IOUT, 70)X
45400	70	FORMAT('+ EXEMPTIONS X $750.',F12.2/)
45500		IF(JIT.NE.'Y')GO TO 71
45600		CALL TYP(48,'A')
45700		T48=T46-X
45800		T48B=T46B-X
45900		WRITE(IOUT, 71)T48
46000	71	FORMAT('+ TAXABLE INCOME -- ',F12.2/)
46100		CALL TYP(48,'B')
46200		WRITE(IOUT, 71)T48B
46300	7216	WRITE(IOUT, 72)
46400	72	FORMAT(//' FIGURE YOUR TAX WITH SCHED. X,Y OR Z.'/)
46500		IF(ACC.EQ.0)GO TO 73
46600		TYPE 722
46700	722	FORMAT(' TYPE APPROPRIATE $, % AND $ FROM LAST 2 COLUMNS OF 
46800		1SCHEDULES X, Y OR Z.'/)
46900		ACCEPT 1,X,Y,Z
47000		IF(X.EQ.-99)GO TO 142
47100		TAX=X+(T48-Z)*Y/100.
47200	73	FORMAT('+ YOUR TAX --  ',F12.2/)
47300		CALL TYP(16,I)
47400		WRITE(IOUT,73)TAX
47500	C******  CREDITS ********************
47600	741	FORMAT(' ----- CREDITS'/)
47700		WRITE(IOUT,741)
47750	
47760		IF(ACC.EQ.0.AND.T54.EQ.0)GO TO 1605
47775		WRITE(IOUT,602)
47800		CALL TYP(49,I)
47900	742	FORMAT('+ RETIREMENT INCOME CREDIT. (SCHED. R) '$)
48000		WRITE(IOUT,742)
48100		IF(ACC)ACCEPT 1,RIC
48150		IF(RIC.EQ.-999)GO TO 1605
48200		IF(RIC.EQ.-99)GO TO 142
48300		IF(ACC.EQ.0)WRITE(IOUT,2)RIC
48400	743	FORMAT('+ INVESTMENT CREDIT. (FORM 3468) '$)
48500		CALL TYP(50,I)
48600		WRITE(IOUT,743)
48700		IF(ACC)ACCEPT 1,RIVC
48800		IF(RIVC.EQ.-99)GO TO 742
48900		IF(ACC.EQ.0)WRITE(IOUT,2)RIVC
49000	744	FORMAT('+ FOREIGN TAX CREDIT. (FORM 1116) '$)
49100		CALL TYP(51,I)
49200		WRITE(IOUT,744)
49300		IF(ACC)ACCEPT 1,FTX
49400		IF(FTX.EQ.-99)GO TO 743
49500		IF(ACC.EQ.0)WRITE(IOUT,2)FTX
49600	745	FORMAT('+ CREDIT FOR CONTRBS. TO CANDS. (SEE PG.9) '$)
49700		CALL TYP(52,I)
49800		WRITE(IOUT,745)
49900		IF(ACC)ACCEPT 1,CCC
50000		IF(CCC.EQ.-99)GO TO 744
50100		IF(ACC.EQ.0)WRITE(IOUT,2)CCC
50200	746	FORMAT('+ WORK INCENTIVE CREDIT. (FORM 4874) '$)
50300		CALL TYP(53,I)
50400		WRITE(IOUT,746)
50500		IF(ACC)ACCEPT 1,WIC
50600		IF(WIC.EQ.-99)GO TO 745
50700		IF(ACC.EQ.0)WRITE(IOUT,2)WIC
50800		CALL TYP(54,I)
50900		T54=RIC+FTX+CCC+WIC+RIVC
51000		WRITE(IOUT,60)T54
51100	C******************************* PAGE 1 AGAIN ***********
51150		WRITE(IOUT,603)
51200	1605	CALL TYP(17,I)
51250		IF(RIC.EQ.-999)RIC=0
51300		WRITE(IOUT, 74)T54
51400	74	FORMAT('+ TOTAL CREDITS.',F12.2/)
51500		T18=TAX-T54
51600		CALL TYP(18,I)
51700		WRITE(IOUT, 75),T18
51800	75	FORMAT('+ ******** INCOME TAX ******',F12.2/)
51900	C********  BACK TO PAGE 2 **************************
52000	760	FORMAT('+ SELF-EMPLOYMENT TAX. (SCHED. SE) '$)
52010		IF(ACC.EQ.0.AND.T61.EQ.0)GO TO 1606
52050		WRITE(IOUT,602)
52100		CALL TYP(55,I)
52200		WRITE(IOUT,760)
52300		IF(ACC)ACCEPT 1,SETX
52350		IF(SETX.EQ.-999)GO TO 1606
52400		IF(SETX.EQ.-99)GO TO 74
52500		IF(ACC.EQ.0)WRITE(IOUT,2)SETX
52600	761	FORMAT('+ TAX FROM RECOMPUTING INV.(FORM 4255) '$)
52700		CALL TYP(56,I)
52800		WRITE(IOUT,761)
52900		IF(ACC)ACCEPT 1,TRI
53000		IF(TRI.EQ.-99)GO TO 760
53100		IF(ACC.EQ.0)WRITE(IOUT,2)TRI
53200	762	FORMAT('+ TAX FROM RECOMPUTING WIN. (+ SCHED.) '$)
53300		CALL TYP(57,I)
53400		WRITE(IOUT,762)
53500		IF(ACC)ACCEPT 1,TRW
53600		IF(TRW.EQ.-99)GO TO 761
53700		IF(ACC.EQ.0)WRITE(IOUT,2)TRW
53800	763	FORMAT('+ MINIMUM TAX? (FORM 4725) '$)
53900		CALL TYP(58,I)
54000		WRITE(IOUT,763)
54100		IF(ACC)ACCEPT 1,RMT
54200		IF(RMT.EQ.-99)GO TO 762
54300		IF(ACC.EQ.0)WRITE(IOUT,2)RMT
54400	764	FORMAT('+ SOCIAL SECURITY TAX ON TIPS. (FORM 4137) '$)
54500		CALL TYP(59,I)
54600		WRITE(IOUT,764)
54700		IF(ACC)ACCEPT 1,SST
54800		IF(ACC.EQ.0)WRITE(IOUT,2)SST
54900		IF(SST.EQ.-99)GO TO 763
55000	765	FORMAT('+ UNCOLLECTED SOC. SEC. TAX ON TIPS. '$)
55100		CALL TYP(60,I)
55200		WRITE(IOUT,765)
55300		IF(ACC)ACCEPT 1,TIPS
55400		IF(TIPS.EQ.-99)GO TO 764
55500		IF(ACC.EQ.0)WRITE(IOUT,2)TIPS
55600		CALL TYP(61,I)
55700		T61=TIPS+SST+RMT+TRW+TRI+SETX
55800		WRITE(IOUT,60)T61
55825	
55840	C***** BACK TO PG.1 *******
55850		WRITE(IOUT,603)
55900	1606	CALL TYP(19,I)
55950		IF(SETX.EQ.-999)SETX=0
56000		WRITE(IOUT, 76)T61
56100	76	FORMAT('+ OTHER TAXES (LINE 61). ',F12.2/)
56200		T20T=TAX+T61
56300		CALL TYP(20,I)
56400		WRITE(IOUT, 60)T20T
56500	7721	CALL TYP(21,'A')
56600	77	FORMAT('+ FEDERAL TAX WITHHELD.'/)
56700		WRITE(IOUT, 77)
56800		IF(ACC)ACCEPT 1,WTAX
56900		IF(WTAX(1).EQ.-99)GO TO 75
57000		CALL ADUP(WT,WTAX)
57100		CALL TYP(21,'A')
57200		WRITE(IOUT, 60)WT
57300		CALL TYP(21,'B')
57400		WRITE(IOUT, 78)
57500	78	FORMAT('+ 1973 ESTIMATED TAX PAYMENTS.'/)
57600		IF(ACC)ACCEPT 1,ETAX
57700		IF(ETAX(1).EQ.-99)GO TO 77
57800		CALL ADUP(ET,ETAX)
57900	79	FORMAT('+ AMOUNT PAID WITH FORM 4868.  '$)
58000		CALL TYP(21,'C')
58100		WRITE(IOUT, 79)
58200		IF(ACC)ACCEPT 1,FORM
58300		IF(FORM.EQ.-99)GO TO 78
58400		IF(ACC.EQ.0)WRITE(IOUT,2)FORM
58500	80	CALL TYP(21,'D')
58600		WRITE(IOUT, 26)
58650		
58660		IF(ACC.EQ.0.AND.T65.EQ.0)GO TO 1607
58675		WRITE(IOUT,602)
58700	800	FORMAT('+ EXCESS FICA TAX WITHHELD. (SEE PG.9) '/)
58800		CALL TYP(62,I)
58900		WRITE(IOUT,800)
59000		IF(ACC)ACCEPT 1,FICA
59100		IF(FICA(1).EQ.-99)GO TO 78
59150		IF(FICA(1).EQ.-999)GO TO 1607
59200		CALL ADUP(FIC,FICA)
59300	801	FORMAT('+ CREDIT FOR FED. TAX ON FUELS. (FORM 4136) '$)
59400		CALL TYP(63,I)
59500		WRITE(IOUT,801)
59600		IF(ACC)ACCEPT 1,FUEL
59700		IF(FUEL.EQ.-99)GO TO 800
59800		IF(ACC.EQ.0)WRITE(IOUT,2)FUEL
59900	802	FORMAT('+ CREDIT FROM REGULATED INVSTMT. CO. (FORM 2439) '$)
60000		CALL TYP(64,I)
60100		WRITE(IOUT,802)
60200		IF(ACC)ACCEPT 1,CRICC
60300		IF(CRICC.EQ.-99)GO TO 801
60400		IF(ACC.EQ.0)WRITE(IOUT,2)CRICC
60500		T65=FIC+FUEL+CRICC
60600		CALL TYP(65,T54,I)
60700		WRITE(IOUT,60)T65
60710	
60755		WRITE(IOUT,603)
60800	1607	CALL TYP(21,'D')
60850		IF(FICA(1).EQ.-999)FICA(1)=0
60900		WRITE(IOUT, 26)
61000		IF(ACC.EQ.0)WRITE(IOUT,2)T65
61100		T22=WT+ET+FORM+T65
61200		CALL TYP(22,I)
61300		WRITE(IOUT, 60)T22
61500		T23=T20T-T22
61600		T23T=T23
61700		IF(T23T)T23T=0
61800		CALL TYP(23,I)
61900	82	FORMAT('+ BALANCE DUE. ------ ',F12.2/)
62000		WRITE(IOUT, 82)T23T
62100		T23=-T23
62200		IF(T23)T23=0
62300		CALL TYP(24,I)
62400		WRITE(IOUT, 83)T23
62500	83	FORMAT('+ OVERPAID ---------- ',F12.2)
62600		CALL TYP(25,I)
62700		WRITE(IOUT, 84)T23
62800	84	FORMAT('+ REFUNDED TO YOU --- ',F12.2)
62810		IF(IOUT.EQ.3)CALL EXIT
62850		IF(ACC.EQ.0)GO TO 860
62900		WRITE(IOUT, 85)
63100	85	FORMAT(//' TYPE FILE NAME.  '$)
63200		ACCEPT 4,NAME
63300		CALL OFILE(1,NAME)
63400		WRITE(1)
63500		1 WAGES,DIV,RINT,BINC,RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
63600		1 CAS,SUPS,ROY,PENS,CAPG,SITR,TRW,TRI,SETX,FUEL,CRICC,FICA,
63700		1 OTH,EBEX,RMED(20),TAXES,XOTH,CONTR,JIT,T61,T65,T54,
63800		1 TLOSS,RMIN,DOC,DOTH,RTAX,RMORT,
63900		1 ROTH,OCONT,OCASH,UNION,RMOTH,WTAX
64000		WRITE(1)ETAX,EX,WG,DT,DEX,TOTD,RT,BI,CA,SU,RY,PE,CP,SI,
64100		1 ALM,OT,T38,T13,SICK,RMEX,EB,SER,T43,T15,RMI
64200		1,T1,RM,T4,T5,DO,HOSP,DT,T7,T8,T9,T10,TA,RX,GTAX,STAX
64300		WRITE(1)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
64400		1 T27,T28,T29,ALIMONY,UN,RMO,T34,T10,T17,T41,T45B,T46,T46B
64500		1,T48,T48B,TAX,T18,CRED,T20T,OTAX,WT,ETAX,FORM,T22,OTX
64600		1,T23T,T23,K
64700		GO TO 5
64800	201	CALL IFILE(21,NAME)
64900		READ(21)
65000		1 WAGES,DIV,RINT,BINC,RIC,FTX,CCC,WIC,RIVC,TIPS,SST,RMT,
65100		1 CAS,SUPS,ROY,PENS,CAPG,SITR,TRW,TRI,SETX,FUEL,CRICC,FICA,
65200		1 OTH,EBEX,RMED(20),TAXES,XOTH,CONTR,JIT,T61,T65,T54,
65300		1 TLOSS,RMIN,DOC,DOTH,RTAX,RMORT,
65400		1 ROTH,OCONT,OCASH,UNION,RMOTH,WTAX
65500		READ(21)ETAX,EX,WG,DT,DEX,TOTD,RT,BI,CA,SU,RY,PE,CP,SI,
65600		1 ALM,OT,T38,T13,SICK,RMEX,EB,SER,T43,T15,RMI
65700		1,T1,RM,T4,T5,DO,HOSP,DT,T7,T8,T9,T10,TA,RX,GTAX,STAX
65800		READ(21)PTAX,XO,T17,RMO,ROH,T20,CO,OC,OCA,PRIOR,T24,RLOSS,RIR,
65900		1 T27,T28,T29,ALIMONY,UN,RMO,T34,T10,T17,T41,T45B,T46,T46B
66000		1,T48,T48B,TAX,T18,CRED,T20T,OTAX,WT,ETAX,FORM,T22,OTX
66100		1,T23T,T23,K
66200	860	TYPE 86
66300	86	FORMAT(' R=REWORK, T=TYPE ON TTY, L=LIST ON LPT.'/)
66400		ACCEPT 3,N
66500		IF(N.EQ.'R')GO TO 87
66600		ACC=0
66700		IF(N.EQ.'T')GO TO 4 
66800		IOUT=3
66900		GO TO 4
67000	87	TYPE 88
67100	88	FORMAT(' START AT LINE 9,16,21,28,39,44,49,55,62 -- OR IN 
67200		1 SCHED. A, 1,11,18,25,30?'/)
67300		ACCEPT 1,X
67400		K=X
67500		IF(K.GT.30)GO TO 89
67600		GO TO(119,1,1,1,1,1,1,1, 1100,1, 43,1,1,1,1, 7216,1, 130,
67700		1 1,1, 7721,1,1,1, 137,1,1, 17,1, 139)K
67800	89	J=K-38
67900		GO TO(27,1,1,1,1)J
68000	C  ABOVE NOT FINISHED.
68100	5	END